home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / tiptrix / listing2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-10-13  |  2.8 KB  |  88 lines
  1. unit CustomColours;
  2. interface
  3. uses
  4.   SysUtils, Classes, Graphics, DsgnIntf ;
  5. const
  6.   clSproog  = $00234567 ;
  7.   clFangle  = $00765432 ;
  8.   clRelmist = $00767676 ;
  9.   clPogarth = $0012AA21 ;
  10.   Colors : array[ 0..3 ] of integer =
  11.            ( clSproog, clFangle, clRelmist, clPogarth ) ;
  12.   ColorStrings : array[ Low( Colors )..High( Colors ) ] of string =
  13.                  ( 'clSproog', 'clFangle', 'clRelmist', 'clPogarth' ) ;
  14. type
  15.   TMyColorProperty = class( TColorProperty )
  16.   protected
  17.     function  GetValue : string ; override ;
  18.     procedure GetValues( Proc : TGetStrProc ) ; override ;
  19.     procedure SetValue( const Value : string ) ; override ;
  20.   end ;
  21. // replacements for color functions in Graphics.pas
  22. function ColorToString( Color : TColor ) : string ;
  23. function StringToColor( const S : string ) : TColor ;
  24. function ColorToIdent( Color : longint ; var Ident : string ) : boolean ;
  25. function IdentToColor( const Ident : string ; var Color : longint ) : Boolean ;
  26. procedure Register ;
  27. implementation
  28. function  ColorToIdent( Color : longint ; var Ident : string ) : boolean ;
  29. var i : integer ;
  30. begin
  31.   for i := Low( Colors ) to High( Colors ) do
  32.     if Color = Colors[ i ] then
  33.   begin
  34.     Ident := ColorStrings[ i ] ;
  35.     Result := true ;
  36.     exit ;
  37.   end ;
  38.   Result := Graphics.ColorToIdent( Color, Ident ) ;
  39. end ;
  40. function IdentToColor( const Ident : string ; var Color : longint ) : Boolean ;
  41. var i : integer ;
  42. begin
  43.   for i := Low( ColorStrings ) to High( ColorStrings ) do
  44.     if AnsiCompareText( Ident, ColorStrings[ i ] ) = 0 then
  45.   begin
  46.     Color := Colors[ i ] ;
  47.     Result := true ;
  48.     exit ;
  49.   end ;
  50.   Result := Graphics.IdentToColor( Ident, Color ) ;
  51. end ;
  52. function ColorToString( Color : TColor ) : string ;
  53. begin
  54.   if not ColorToIdent( Color, Result ) then
  55.     FmtStr( Result, '$%.8x', [ Color ] ) ;
  56. end;
  57. function StringToColor( const S : string ) : TColor ;
  58. begin
  59.   if not IdentToColor( S, Longint( Result ) ) then
  60.     Result := TColor( StrToInt( S ) ) ;
  61. end;
  62. function  TMyColorProperty.GetValue : string ;
  63. begin
  64.   Result := ColorToString( TColor( GetOrdValue ) ) ;
  65. end;
  66. procedure TMyColorProperty.GetValues( Proc : TGetStrProc ) ;
  67. var i : integer ;
  68. begin
  69.   // add our colours first - call inherited first to have our colours at
  70.   // the end of the list
  71.   for i := Low( ColorStrings ) to High( ColorStrings ) do
  72.     Proc( ColorStrings[ i ] ) ;
  73.   inherited GetValues( Proc ) ;
  74. end ;
  75. procedure TMyColorProperty.SetValue( const Value : string ) ;
  76. var ColorValue : longint ;
  77.     i : integer ;
  78. begin
  79.   if IdentToColor( Value, ColorValue ) then SetOrdValue( ColorValue ) 
  80. else
  81.     inherited SetValue( Value ) ;
  82. end ;
  83. procedure Register ;
  84. begin
  85.   RegisterPropertyEditor( TypeInfo( TColor ), NIL, '', TMyColorProperty ) ;
  86. end ;
  87. end.
  88.